home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / ILUMP.ICN < prev    next >
Text File  |  1993-01-27  |  2KB  |  102 lines
  1. ############################################################################
  2. #
  3. #    File:     ilump.icn
  4. #
  5. #    Subject:  Program to lump linked Icon source files
  6. #
  7. #    Author:   Gregg M. Townsend
  8. #          (Inspired by an earlier version by Clinton L. Jeffery)
  9. #
  10. #    Date:     July 21, 1992
  11. #
  12. ###########################################################################
  13. #  
  14. #  usage:  ilump [file...]
  15. #
  16. #     ilump copies one or more Icon source files, incorporating recursively
  17. #  the source code for files named by "link" directives.  This produces a
  18. #  standalone source program in one file, which is useful with certain
  19. #  profiling and visualization tools.
  20. #
  21. #     Searching for link'd source files is similar to the action of Iconc
  22. #  under UNIX.  If a link'd file is not found in the current directory,
  23. #  directories specified by the LPATH environment variable are tried.
  24. #
  25. ############################################################################
  26.  
  27.  
  28. global path, todo
  29.  
  30.  
  31. procedure main(args)
  32.    local fname
  33.  
  34.    path := [""]
  35.    getenv("LPATH") ? repeat {
  36.       tab(many(' '))
  37.       if pos(0) then
  38.      break
  39.       put(path, tab(upto(' ')|0) || "/")
  40.    }
  41.    todo := args
  42.    if *todo = 0 then
  43.       dofile(&input)
  44.    while fname := get(todo) do
  45.       dofile(newfile(fname))
  46. end
  47.  
  48.  
  49. #  newfile(fname) -- open and return a file, if it wasn't seen earlier
  50.  
  51. procedure newfile(fname)
  52.    local f, fullname
  53.    static done
  54.    initial done := set()
  55.  
  56.    if member(done, fname) then
  57.       fail
  58.    insert(done, fname)
  59.    if f := open(fullname := !path || fname) then {
  60.       write("\n\n\n#", right("  "||fullname,78,"="), "\n\n\n")
  61.       return f
  62.       }
  63.    else {
  64.       write(&errout, "can't open ", fname);
  65.       write("\n\n\n#", right("  can't open "||fname,78,"="), "\n\n\n")
  66.       fail
  67.       }
  68.    end
  69.  
  70.  
  71. #  dofile(f) -- copy one file, stacking file names seen on link directives
  72.  
  73. procedure dofile(f)
  74.    local line, base
  75.    static idset
  76.    initial idset := &letters ++ &digits ++ '_'
  77.  
  78.    while line := read(f) do {
  79.       line ? {
  80.      tab(many(' \t'))
  81.      if ="link" & not any(idset) then {
  82.         write("#====== ", line)
  83.         repeat {
  84.            tab(many(' \t,'))
  85.            if pos(0) | ="#" then
  86.           break
  87.            if ="\"" then
  88.           base := tab(upto('"')|0)
  89.            else
  90.           base := tab(many(idset)) | break
  91.            put(todo, base || ".icn")
  92.            }
  93.         }
  94.      else {
  95.         write(line)
  96.         }
  97.      }
  98.       }
  99.     
  100.    close(f)
  101.    end
  102.